home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / allfil.zip / ALLFILES.PAS < prev    next >
Pascal/Delphi Source File  |  1984-12-19  |  2KB  |  76 lines
  1. {%%%%%%%%%%%%%%%%%%% copyright 1984 by Neil J. Rubenking %%%%%%%%%%%%%%%%%%%
  2.  
  3. driver for procedure ALLFILES.  Pass upper left and lower right corners
  4. of a window to ALLFILES, along with a template of the required files.
  5. ALLFILES returns the selected fileNAME, or an error code.
  6.  
  7. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
  8. {$I filename.typ}
  9. {$I regpack.typ}
  10. {$I getkeys.lib}
  11. {$I monitor.lib}
  12. {$I screen.lib}
  13. {$I getfile.lib}
  14. {$I allfiles.lib}
  15.  
  16. var
  17.   error_return,
  18.   x1,y1,x2,y2 : byte;
  19.   FullPath,
  20.   template    : filename_type;
  21.  
  22. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  23. function lastPos(C: char; S:filename_type):byte;
  24. var
  25.   temp, holder : byte;
  26. begin
  27.   temp := 0;
  28.   while pos(C,S) <> 0 do
  29.     begin
  30.       temp := temp + pos(C,S);
  31.       delete(S,1,pos(C,S));
  32.     end;
  33.   lastPos := temp;
  34. end;
  35. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  36.  
  37. begin
  38.   CheckColor;  {in order to use the procedures in SCREEN.LIB, you must
  39.                    first set the value of SCREENSEG by doing CheckColor}
  40.   Write('Enter the upper left column for choice window (2 to 43): ');
  41.   read(x1);WriteLn;
  42.   Write('Enter the upper left row for choice window (3 to 20) : ');
  43.   read(y1);WriteLn;
  44.   Write('Enter the lower right column for choice window: (');
  45.   Write(x1+36,' to 79)');
  46.   read(x2);WriteLn;
  47.   Write('Enter the lower right row for choice window: (');
  48.   Write(y1+3,' to 23)');
  49.   read(y2);WriteLn;
  50.   if (x1 < x2) and (y1 < y2) and (x1 in [2..43]) and ( y1 in [3..22]) and
  51.       (x2 in [(x1+36)..79]) and (y2 in [(y1+3)..23]) then
  52.     begin
  53.       ClrScr;
  54.       WriteLn('Enter the template for files from which you want to select.');
  55.       WriteLn('Full PathNames are fine.  e.g., d:\accounts\overdue\*.*,');
  56.       WriteLn('C:\programs\*.bas, and so on.');
  57.       Write('->');ReadLn(template);
  58.       FullPath := template;
  59.       if lastPos('\',FullPath) <> 0 then
  60.         FullPath := copy(FullPath,1,lastPos('\',FullPath))
  61.       else
  62.         if pos(':',FullPath) <> 0 then
  63.           FullPath := copy(FullPath,1,2)
  64.         else FullPath := '';
  65.       ClrScr;
  66.       AllFiles(x1,y1,x2,y2,template,error_return);
  67.       GotoXY(1,1);
  68.       if error_return = 0 then
  69.         WriteLn(FullPath,template,' has been selected.')
  70.       else WriteLn('Error--no such files available.');
  71.     end
  72.   else WriteLn('Invalid set of coordinates.  Try again.');
  73. end.
  74.  
  75.  
  76.